install.packages("fastDummies")
install.packages("gmodels")
library(gmodels)

library(tidyverse)
library(rstatix)
library(ggpubr)
library(ggplot2)
library(dplyr)
library(reshape2)
library(tidyr)
library(haven)
library(fastDummies)
########THESE PACKAGES ARE NEW
require(foreign)
require(nnet)
library(fastDummies)
library(boot)
theme_set(theme_pubr())

# Load PEM key by level
prehspem <- read.csv("C:/Users/dhdan/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Weighted PEM prehs 012821.csv")
hspem <- read.csv("C:/Users/dhdan/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Weighted PEM hs 012821.csv")
collegepem <- read.csv("C:/Users/dhdan/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Weighted PEM college 012821.csv")

#Work Computer
prehspem <- read.csv("C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Weighted PEM prehs 012821.csv")
hspem <- read.csv("C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Weighted PEM hs 012821.csv")
collegepem <- read.csv("C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Weighted PEM college 012821.csv")

# Create pro PEM from college PEM
propem <- collegepem
colnames(propem) <- c("Primarypositionpro","pro_freq","pro_linacc","pro_rot")

spropem <- collegepem
colnames(spropem) <- c("Primarypositionspro","spro_freq","spro_linacc","spro_rot")

# Create offensive pro PEM from pro PEM
off_propem <- propem
colnames(off_propem) <- c("Pro_OffPos_JSS","opro_freq","opro_linacc","opro_rot")

# Create defensive pro PEM from pro PEM
def_propem <- propem
colnames(def_propem) <- c("Pro_DefPos_JSS","dpro_freq","dpro_linacc","dpro_rot")

# Create offensive semi pro PEM from pro PEM
off_spropem <- propem
colnames(off_spropem) <- c("spro_pos_off","ospro_freq","ospro_linacc","ospro_rot")

# Create defensive semi pro PEM from pro PEM
def_spropem <- propem
colnames(def_spropem) <- c("spro_pos_def","dspro_freq","dspro_linacc","dspro_rot")

# Create offensive college PEM from college PEM
off_collegepem <- collegepem
colnames(off_collegepem) <- c("col_pos_off","ocol_freq","ocol_linacc","ocol_rot")

# Create defensive college PEM from college PEM
def_collegepem <- collegepem
colnames(def_collegepem) <- c("col_pos_def","dcol_freq","dcol_linacc","dcol_rot")

# Create offensive high school PEM from high school PEM
off_hspem <- hspem
colnames(off_hspem) <- c("hs_pos_off","ohs_freq","ohs_linacc","ohs_rot")

# Create defensive high school PEM from high school PEM
def_hspem <- hspem
colnames(def_hspem) <- c("hs_pos_def","dhs_freq","dhs_linacc","dhs_rot")


# Load donor data
donordat <- read_sav("C:/Users/dhdan/Dropbox (Personal)/Personal/Papers/Exposure/M56026060_Attachments/Exposurepaper 111621.sav")

#Work Computer
donordat <- read_sav("C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/M56026060_Attachments/Exposurepaper 111621.sav")

# Assign 0 to NA for positions and years
donordat$Primarypositionpro <- replace_na(donordat$Primarypositionpro,0)
donordat$Primarypositionspro <- replace_na(donordat$Primarypositionspro,0)
donordat$Primarypositioncol <- replace_na(donordat$Primarypositioncol,0)
donordat$Primarypositionhs <- replace_na(donordat$Primarypositionhs,0)
donordat$Primarypositionyouth <- replace_na(donordat$Primarypositionyouth,0)

donordat$Pro_OffPos_JSS <- replace_na(donordat$Pro_OffPos_JSS,0)
donordat$Pro_DefPos_JSS <- replace_na(donordat$Pro_DefPos_JSS,0)
donordat$spro_pos_off <- replace_na(donordat$spro_pos_off,0)
donordat$spro_pos_def <- replace_na(donordat$spro_pos_def,0)
donordat$col_pos_off <- replace_na(donordat$col_pos_off,0)
donordat$col_pos_def <- replace_na(donordat$col_pos_def,0)
donordat$hs_pos_off <- replace_na(donordat$hs_pos_off,0)
donordat$hs_pos_def <- replace_na(donordat$hs_pos_def,0)
donordat$prehs_pos_off <- replace_na(donordat$prehs_pos_off,0)
donordat$prehs_pos_def <- replace_na(donordat$prehs_pos_def,0)

donordat$allproyrs <- replace_na(donordat$allproyrs,0)
donordat$pro_years <- replace_na(donordat$pro_years,0)
donordat$YrsFootballSemiPro <- replace_na(donordat$YrsFootballSemiPro,0)
donordat$college_years <- replace_na(donordat$college_years,0)
donordat$hs_years <- replace_na(donordat$hs_years,0)
donordat$prehs_years <- replace_na(donordat$prehs_years,0)


# Assign unknown/multiple positions to highest level of single position played
#donordat$Primarypositioncol <- with(donordat, ifelse(Primarypositioncol == 11 & Primarypositionpro != 0, 
#                                                     Primarypositionpro, Primarypositioncol ) )

#donordat$Primarypositionhs <- with(donordat, ifelse(Primarypositionhs == 11 & Primarypositioncol != 0, 
#                                                     Primarypositioncol, Primarypositionhs ) )

#donordat$Primarypositionyouth <- with(donordat, ifelse(Primarypositionyouth == 11 & Primarypositionhs != 0, 
#                                                     Primarypositionhs, Primarypositionyouth ) )

#Print missing positions
#donordat$subjid[donordat$Primarypositionpro == 11 | donordat$Primarypositioncol == 11 | 
#                  donordat$Primarypositionhs == 11 | donordat$Primarypositionyouth == 11]


# First, assign position names to all primary positions
# Convert P, K, Oth and Unk to Overall. 13 = Multiple = Overall
position_labels <- c("0","OL","TE","QB","RB","WR","DL","LB","DB","Overall","Overall","Overall","Overall","M")

donordat$Primarypositionpro <- factor(donordat$Primarypositionpro,
                                         c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),position_labels)
donordat$Primarypositionspro <- factor(donordat$Primarypositionspro,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),position_labels)
donordat$Primarypositioncol <- factor(donordat$Primarypositioncol,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),position_labels)
donordat$Primarypositionhs <- factor(donordat$Primarypositionhs,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),position_labels)
donordat$Primarypositionyouth <- factor(donordat$Primarypositionyouth,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),position_labels)

# Assign position labels to all offensive positions
off_position_labels <- c("0","OL","OL","OL","TE","OL","QB","RB","RB","RB","WR","WR","Overall","Overall")

donordat$Pro_OffPos_JSS <- factor(donordat$Pro_OffPos_JSS,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),off_position_labels)
donordat$spro_pos_off <- factor(donordat$spro_pos_off,
                                c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),off_position_labels)
donordat$col_pos_off <- factor(donordat$col_pos_off,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),off_position_labels)
donordat$hs_pos_off <- factor(donordat$hs_pos_off,
                                     c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),off_position_labels)
donordat$prehs_pos_off <- factor(donordat$prehs_pos_off,
                                        c("0","1","2","3","4","5","6","7","8","9","10","11","12","13"),off_position_labels)

# Assign position labels to all defensive positions
def_position_labels <- c("0","DL","DL","DL","DL","DL","LB","LB","LB","LB","LB","DB","DB","DB","DB","DB","Overall","Overall")

donordat$Pro_DefPos_JSS <- factor(donordat$Pro_DefPos_JSS,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17"),def_position_labels)
donordat$spro_pos_def  <- factor(donordat$spro_pos_def,
                                 c("0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17"),def_position_labels)
donordat$col_pos_def <- factor(donordat$col_pos_def,
                                      c("0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17"),def_position_labels)
donordat$hs_pos_def <- factor(donordat$hs_pos_def,
                                     c("0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17"),def_position_labels)
donordat$prehs_pos_def <- factor(donordat$prehs_pos_def,
                                        c("0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17"),def_position_labels)

# Create an Overall for all athletes that can be used for youth levels
donordat$All=1 
donordat$All <- factor(donordat$All,
                         c("1"),"Overall")

#save test file
#write.csv(donordat, file = "C:\\Users\\dhdan\\Dropbox (Personal)\\Personal\\Papers\\Exposure\\Personal PEM 2020\\Test Data\\level.csv", row.names = FALSE)

#Merge PEM variables onto donordat by primary position at each level
donordat<- merge(donordat, prehspem, by=c("All"), all.x=T)
donordat<- merge(donordat, hspem, by=c("Primarypositionhs"), all.x=T)
donordat<- merge(donordat, collegepem, by=c("Primarypositioncol"), all.x=T)
donordat<- merge(donordat, spropem, by=c("Primarypositionspro"), all.x=T)
donordat<- merge(donordat, propem, by=c("Primarypositionpro"), all.x=T)

#Merge PEM variables onto donordat by offensive and defensive positions at each level
donordat<- merge(donordat, off_propem, by=c("Pro_OffPos_JSS"), all.x=T)
donordat<- merge(donordat, off_spropem, by=c("spro_pos_off"), all.x=T)
donordat<- merge(donordat, def_propem, by=c("Pro_DefPos_JSS"), all.x=T)
donordat<- merge(donordat, def_spropem, by=c("spro_pos_def"), all.x=T)
donordat<- merge(donordat, off_collegepem, by=c("col_pos_off"), all.x=T)
donordat<- merge(donordat, def_collegepem, by=c("col_pos_def"), all.x=T)
donordat<- merge(donordat, off_hspem, by=c("hs_pos_off"), all.x=T)
donordat<- merge(donordat, def_hspem, by=c("hs_pos_def"), all.x=T)

#save test file
#write.csv(donordat, file = "C:\\Users\\dhdan\\Dropbox (Personal)\\Personal\\Papers\\Exposure\\Personal PEM 2020\\Test Data\\merge.csv", row.names = FALSE)

# Average multiple positions
donordat$hs_freq <- ifelse (donordat$Primarypositionhs %in% c('M'),(donordat$ohs_freq + donordat$dhs_freq)/2,donordat$hs_freq)
donordat$hs_linacc <- ifelse (donordat$Primarypositionhs %in% c('M'),(donordat$ohs_linacc + donordat$dhs_linacc)/2,donordat$hs_linacc)
donordat$hs_rot <- ifelse (donordat$Primarypositionhs %in% c('M'),(donordat$ohs_rot + donordat$dhs_rot)/2,donordat$hs_rot)

donordat$college_freq <- ifelse (donordat$Primarypositioncol %in% c('M'),(donordat$ocol_freq + donordat$dcol_freq)/2,donordat$college_freq)
donordat$college_linacc <- ifelse (donordat$Primarypositioncol %in% c('M'),(donordat$ocol_linacc + donordat$dcol_linacc)/2,donordat$college_linacc)
donordat$college_rot <- ifelse (donordat$Primarypositioncol %in% c('M'),(donordat$ocol_rot + donordat$dcol_rot)/2,donordat$college_rot)

donordat$spro_freq <- ifelse (donordat$Primarypositionspro %in% c('M'),(donordat$ospro_freq + donordat$dspro_freq)/2,donordat$spro_freq)
donordat$spro_linacc <- ifelse (donordat$Primarypositionspro %in% c('M'),(donordat$ospro_linacc + donordat$dspro_linacc)/2,donordat$spro_linacc)
donordat$spro_rot <- ifelse (donordat$Primarypositionspro %in% c('M'),(donordat$ospro_rot + donordat$dspro_rot)/2,donordat$spro_rot)

donordat$pro_freq <- ifelse (donordat$Primarypositionpro %in% c('M'),(donordat$opro_freq + donordat$dpro_freq)/2,donordat$pro_freq)
donordat$pro_linacc <- ifelse (donordat$Primarypositionpro %in% c('M'),(donordat$opro_linacc + donordat$dpro_linacc)/2,donordat$pro_linacc)
donordat$pro_rot <- ifelse (donordat$Primarypositionpro %in% c('M'),(donordat$opro_rot + donordat$dpro_rot)/2,donordat$pro_rot)

#save test file
#write.csv(donordat, file = "C:\\Users\\dhdan\\Dropbox (Personal)\\Personal\\Papers\\Exposure\\Personal PEM 2020\\Test Data\\average.csv", row.names = FALSE)


#make cum prehs exposure variables by multiplying preHS level PEM vars to preHS years
donordat$prehs_cum_freq <- (donordat$prehs_freq*donordat$prehs_years)
donordat$prehs_rot <- (donordat$prehs_rot*donordat$prehs_years)
donordat$prehs_linacc <- (donordat$prehs_linacc*donordat$prehs_years)

#make cum hs exposure variables by multiplying HS level PEM vars to HS years
donordat$hs_cum_freq <- (donordat$hs_freq*donordat$hs_years)
donordat$hs_rot <- (donordat$hs_rot*donordat$hs_years)
donordat$hs_linacc <- (donordat$hs_linacc*donordat$hs_years)

#make cum college exposure variables by multiplying college level PEM vars to college years
donordat$college_cum_freq <- (donordat$college_freq*donordat$college_years)
donordat$college_rot <- (donordat$college_rot*donordat$college_years)
donordat$college_linacc <- (donordat$college_linacc*donordat$college_years)

#make cum semipro exposure variables by multiplying semipro level PEM vars to semipro years
donordat$spro_cum_freq <- (donordat$spro_freq*donordat$YrsFootballSemiPro)
donordat$spro_rot <- (donordat$spro_rot*donordat$YrsFootballSemiPro)
donordat$spro_linacc <- (donordat$spro_linacc*donordat$YrsFootballSemiPro)

#make cum pro exposure variables by multiplying pro level PEM vars to pro years
donordat$pro_cum_freq <- (donordat$pro_freq*donordat$pro_years)
donordat$pro_rot <- (donordat$pro_rot*donordat$pro_years)
donordat$pro_linacc <- (donordat$pro_linacc*donordat$pro_years)

#make cum exposure variables by adding exposure variables across levels
donordat$cum_freq <- (donordat$prehs_cum_freq + donordat$hs_cum_freq + 
                        donordat$college_cum_freq + donordat$spro_cum_freq + donordat$pro_cum_freq)
donordat$cum_rot <- (donordat$prehs_rot + donordat$hs_rot + 
                       donordat$college_rot + donordat$pro_rot)
donordat$cum_linacc <- (donordat$prehs_linacc + donordat$hs_linacc + 
                          donordat$college_linacc + donordat$pro_linacc)


#make sum preHS exposure variables by taking exposure for preHS level and dividing hits at that level
donordat$prehs_sum_rot <- (donordat$prehs_rot/donordat$prehs_freq)
donordat$prehs_sum_linacc <- (donordat$prehs_linacc/donordat$prehs_freq)

#make sum hs exposure variables by taking exposure for HS level and dividing hits at that level
donordat$hs_sum_rot <- (donordat$hs_rot/donordat$hs_freq)
donordat$hs_sum_linacc <- (donordat$hs_linacc/donordat$hs_freq)

#make sum college exposure variables by taking exposure for college level and dividing hits at that level
donordat$college_sum_rot <- (donordat$college_rot/donordat$college_freq)
donordat$college_sum_linacc <- (donordat$college_linacc/donordat$college_freq)

#make sum pro exposure variables by taking exposure for spro level and dividing hits at that level
donordat$spro_sum_rot <- (donordat$spro_rot/donordat$spro_freq)
donordat$spro_sum_linacc <- (donordat$spro_linacc/donordat$spro_freq)

#make sum pro exposure variables by taking exposure for pro level and dividing hits at that level
donordat$pro_sum_rot <- (donordat$pro_rot/donordat$pro_freq)
donordat$pro_sum_linacc <- (donordat$pro_linacc/donordat$pro_freq)

#Combine sum exposure variables
donordat$sum_rot <- (donordat$prehs_sum_rot + donordat$hs_sum_rot + 
                       donordat$college_sum_rot + donordat$spro_sum_rot + donordat$pro_sum_rot)
donordat$sum_linacc <- (donordat$prehs_sum_linacc + donordat$hs_sum_linacc + 
                          donordat$college_sum_linacc + donordat$spro_sum_linacc + donordat$pro_sum_linacc)

# Separate dataset for annals donors 
donordat_annals <- donordat[ which(donordat$agedeath >= 20 & donordat$annals == 1), ]

# Separate dataset for post annals donors 
donordat_postannals <- donordat[ which(donordat$agedeath >= 20 & donordat$annals == 0), ]

# Separate dataset for pureCTE donors 
donordat_pureCTE <- donordat[ which(donordat$group == 1), ]

# Separate dataset for pureCTE or pure controls donors 
donordat_noothpath <- donordat[ which(donordat$group == 1 | donordat$group == 4), ]

# Separate dataset for post annals, pureCTE or pure controls donors 
donordat_noothpath_postannals <- donordat[ which(donordat$annals == 0 & (donordat$group == 1 | donordat$group == 4)), ]

# Separate dataset for annals, pureCTE or pure controls donors 
donordat_noothpath_annals <- donordat[ which(donordat$annals == 1 & (donordat$group == 1 | donordat$group == 4)), ]

# Separate dataset for annals, mixed CTE or ND controls 
donordat_othpath_annals <- donordat[ which(donordat$annals == 1 & (donordat$group == 2 | donordat$group == 3)), ]

# Separate dataset for post annals, mixed CTE or ND controls 
donordat_othpath_postannals <- donordat[ which(donordat$annals == 0 & (donordat$group == 2 | donordat$group == 3)), ]

# Separate dataset for all donors age 20 and up 
donordat_age20 <- donordat[ which(donordat$agedeath >= 20), ]

# Separate dataset for all donors with non CTE pathology
donordat_noCTE <- donordat[ which(donordat$group == 3 | donordat$group == 4), ]

# Separate dataset for all donors with non CTE pathology (annals)
donordat_noCTE_annals <- donordat[ which(donordat$annals == 1 & (donordat$group == 3 | donordat$group == 4)), ]

# Separate dataset for all donors with non CTE pathology (post annals)
donordat_noCTE_postannals <- donordat[ which(donordat$annals == 0 & (donordat$group == 3 | donordat$group == 4)), ]

## Select cases that only played football (no military or other contact sports)
donordat_footballonlynomilitary <- subset(donordat, OtherContactSport == 0 & milhx == 0)

# Show table of dementia dx by CTE presence
tab_CTEdement <- CrossTable(donordat$CTE,donordat$DementiaHX)

# Show table of dementia dx by CTE severity
tab_CTEgroupdement <- CrossTable(donordat$CTEgroup,donordat$DementiaHX)


# Show table of average years of play by CTE presence
donordat %>%
  group_by(CTE) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))

# Show table of average years of play by CTE presence for Annals
donordat_annals %>%
  group_by(CTE) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))

# Show table of average years of play by CTE presence for post annals
donordat_postannals %>%
  group_by(CTE) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))

# Show table of average years of play by CTE severity
donordat_postannals %>%
  group_by(CTEStage) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))

# Show table of average years of play by CTE severity for annals
donordat_annals %>%
  group_by(CTEStage) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))

# Show table of average years of play by CTE severity post annals
donordat %>%
  group_by(CTEStage) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))

# Show table of average years of play by CTE stage
donordat %>%
  group_by(CTEgroup) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))

# Years of play by presence of CTE for new dataset overall
CTE_yrs <- glm(CTE ~ footyrs + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_yrs)
exp(summary(CTE_yrs)$coefficients["footyrs",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_yrs)$coefficients["footyrs",2])

# Years of play by presence of CTE for no path besides CTE
CTE_pureCTE_yrs <- glm(CTE ~ footyrs + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTE_pureCTE_yrs)
exp(summary(CTE_pureCTE_yrs)$coefficients["footyrs",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_pureCTE_yrs)$coefficients["footyrs",2])

# Years of play by presence of CTE for no other contact sport or military
CTE_footballonlynomilitary_yrs <- glm(CTE ~ footyrs + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTE_footballonlynomilitary_yrs)
exp(summary(CTE_footballonlynomilitary_yrs)$coefficients["footyrs",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_footballonlynomilitary_yrs)$coefficients["footyrs",2])


# Years of play by presence of CTE for new dataset overall in those age 20 and over
CTE_yrs20 <- glm(CTE ~ footyrs + agedeath, data=donordat_age20, family=binomial(link="logit"))
summary(CTE_yrs20)
exp(coef(CTE_yrs20))

# Analysis of years of play by presence of CTE for annals paper participants
CTE_yrs_annals <- glm(CTE ~ footyrs + agedeath, data=donordat_annals, family=binomial(link="logit"))
summary(CTE_yrs_annals)
exp(coef(CTE_yrs_annals))

# Years of play analysis by presence of CTE post Annals paper 
CTE_yrs_postannals <- glm(CTE ~ footyrs + agedeath, data=donordat_postannals, family=binomial(link="logit"))
summary(CTE_yrs_postannals)
exp(coef(CTE_yrs_postannals))

# Years of play by presence of AD for new dataset overall
AD_yrs <- glm(PathAD ~ footyrs + agedeath, data=donordat, family=binomial(link="logit"))
summary(AD_yrs)
exp(summary(AD_yrs)$coefficients["footyrs",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(AD_yrs)$coefficients["footyrs",2])


# Analysis of years of play by presence of CTE for annals paper participants (no other ND)
CTE_noothpath_annals_yrs <- glm(CTE ~ footyrs + agedeath, data=donordat_noothpath_annals, family=binomial(link="logit"))
summary(CTE_noothpath_annals_yrs)
exp(coef(CTE_noothpath_annals_yrs))
nobs(CTE_noothpath_annals_yrs)

# Years of play analysis by presence of CTE post Annals paper (no other ND)
CTE_yrs_noothpath_postannals <- glm(CTE ~ footyrs + agedeath, data=donordat_noothpath_postannals, family=binomial(link="logit"))
summary(CTE_yrs_noothpath_postannals)
exp(coef(CTE_yrs_noothpath_postannals))
nobs(CTE_yrs_noothpath_postannals)

# Analysis of years of play by presence of CTE for annals paper participants (mixed ND only)
CTE_yrs_othpath_annals <- glm(CTE ~ footyrs + agedeath, data=donordat_othpath_annals, family=binomial(link="logit"))
summary(CTE_yrs_othpath_annals)
exp(coef(CTE_yrs_othpath_annals))
nobs(CTE_yrs_othpath_annals)

# Years of play analysis by presence of CTE post Annals paper (mixed ND only)
CTE_yrs_othpath_postannals <- glm(CTE ~ footyrs + agedeath, data=donordat_othpath_postannals, family=binomial(link="logit"))
summary(CTE_yrs_othpath_postannals)
exp(coef(CTE_yrs_othpath_postannals))
nobs(CTE_yrs_othpath_postannals)


# Separate dataset for all ND donors with non CTE pathology (post annals)
donordat_NDnoCTE_postannals <- donordat[ which(donordat$annals == 0 & (donordat$group == 3)), ]

# Separate dataset for all ND donors with non CTE pathology (annals)
donordat_NDnoCTE_annals <- donordat[ which(donordat$annals == 1 & (donordat$group == 3)), ]

# Years of play analysis by presence of tau in DSFC post Annals paper (mixed ND only)
midfront_yrs_othpath_postannals <- glm(midfront ~ footyrs + agedeath, data=donordat_NDnoCTE_postannals)
summary(midfront_yrs_othpath_postannals)
exp(coef(midfront_yrs_othpath_postannals))
nobs(midfront_yrs_othpath_postannals)

# Years of play analysis by presence of tau in DSFC Annals paper (mixed ND only) 
## Wrong n
midfront_yrs_othpath_annals <- glm(midfront ~ footyrs + agedeath, data=donordat_NDnoCTE_annals)
summary(midfront_yrs_othpath_annals)
exp(coef(midfront_yrs_othpath_annals))


# Significant differences in CTE group by pre/post annals?
Chisq_mixedpath_prepostAnnals <- table(donordat$annals,donordat$group)
chisq.test(Chisq_mixedpath_prepostAnnals)
Chisq_mixedpath_prepostAnnals
chisq.test(Chisq_mixedpath_prepostAnnals)$expected
chisq.test(Chisq_mixedpath_prepostAnnals[, c(1, 4)])
chisq.test(Chisq_mixedpath_prepostAnnals[, c(1, 4)])$expected
chisq.test(Chisq_mixedpath_prepostAnnals[, c(2, 3)])
chisq.test(Chisq_mixedpath_prepostAnnals[, c(2, 3)])$expected


# Years of play by presence of other path in individuals without CTE
donordat_noCTE$noCTE_othpathYN <- donordat_noCTE$group - 3
othpath_yrs <- glm(noCTE_othpathYN ~ footyrs + agedeath, data=donordat_noCTE, family=binomial(link="logit"))
summary(othpath_yrs)
exp(coef(othpath_yrs))

donordat_noCTE_postannals$noCTE_othpathYN <- donordat_noCTE_postannals$group - 3
othpath_yrs_postannals <- glm(noCTE_othpathYN ~ footyrs + agedeath, data=donordat_noCTE_postannals, family=binomial(link="logit"))
summary(othpath_yrs_postannals)
exp(coef(othpath_yrs_postannals))

donordat_noCTE_annals$noCTE_othpathYN <- donordat_noCTE_annals$group - 3
othpath_yrs_annals <- glm(noCTE_othpathYN ~ footyrs + agedeath, data=donordat_noCTE_annals, family=binomial(link="logit"))
summary(othpath_yrs_annals)
exp(coef(othpath_yrs_annals))


# Show table of average years of play by CTE severity
donordat %>%
  group_by(CTEgroup) %>%
  summarize_at(vars(footyrs), list(mean,sd,length,min,max))



#####



# Years of play by severity of CTE for all participants
CTEgroup_yrs <- glm(CTEgroup ~ footyrs + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_yrs)
exp(coef(CTEgroup_yrs))

exp(summary(CTEgroup_yrs)$coefficients["footyrs",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_yrs)$coefficients["footyrs",2])


# Years of play by severity of CTE for pure CTE
CTEgroup_noothpath_yrs <- glm(CTEgroup ~ footyrs + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTEgroup_noothpath_yrs)
exp(coef(CTEgroup_noothpath_yrs))

exp(summary(CTEgroup_noothpath_yrs)$coefficients["footyrs",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_noothpath_yrs)$coefficients["footyrs",2])


# Years of play by severity of CTE for pure football (no military no other sport)
CTEgroup_footballonlynomilitary_yrs <- glm(CTEgroup ~ footyrs + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTEgroup_footballonlynomilitary_yrs)
exp(coef(CTEgroup_footballonlynomilitary_yrs))

exp(summary(CTEgroup_footballonlynomilitary_yrs)$coefficients["footyrs",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_footballonlynomilitary_yrs)$coefficients["footyrs",2])



# Years of play by severity of CTE for annals paper participants
CTEgroup_yrs_annals <- glm(CTEgroup ~ footyrs + agedeath, data=donordat_annals, family=binomial(link="logit"))
summary(CTEgroup_yrs_annals)
exp(coef(CTEgroup_yrs_annals))

# Years of play by severity of CTE for post annals paper participants
CTEgroup_yrs_postannals <- glm(CTEgroup ~ footyrs + agedeath, data=donordat_postannals, family=binomial(link="logit"))
summary(CTEgroup_yrs_postannals)
exp(coef(CTEgroup_yrs_postannals))

# Show table of average years of play by CTE Stage
donordat %>%
  group_by(CTEStage) %>%
  summarize_at(vars(footyrs), list(mean,sd,length))

# Years of play by CTE Stage for new dataset overall
CTEStage_yrs <- multinom(CTEStage ~ footyrs + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
summary(CTEStage_yrs)
exp(coef(CTEStage_yrs))

# test lin acc
years_cumlinacc <- glm(footyrs ~ cum_linacc, data=donordat)
summary(years_cumlinacc)
exp(coef(years_cumlinacc))

# Cumulative linacc by presence of CTE for new dataset overall
donordat$cum_linacc10000 <- donordat$cum_linacc/10000
CTE_cumlinacc <- glm(CTE ~ cum_linacc10000 + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_cumlinacc)
exp(summary(CTE_cumlinacc)$coefficients["cum_linacc10000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_cumlinacc)$coefficients["cum_linacc10000",2])


# Cumulative linacc by severity of CTE for all participants
CTEgroup_cumlinacc <- glm(CTEgroup ~ cum_linacc10000 + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_cumlinacc)
exp(summary(CTEgroup_cumlinacc)$coefficients["cum_linacc10000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_cumlinacc)$coefficients["cum_linacc10000",2])


# Cumulative linacc by presence of CTE for no other pathology besides CTE
donordat_noothpath$cum_linacc10000 <- donordat_noothpath$cum_linacc/10000
CTE_noothpath_cumlinacc <- glm(CTE ~ cum_linacc10000 + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTE_noothpath_cumlinacc)
exp(summary(CTE_noothpath_cumlinacc)$coefficients["cum_linacc10000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_noothpath_cumlinacc)$coefficients["cum_linacc10000",2])


# Cumulative linacc by severity of CTE for no other pathology besides CTE
CTEgroup_noothpath_cumlinacc <- glm(CTEgroup ~ cum_linacc10000 + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTEgroup_noothpath_cumlinacc)
exp(summary(CTEgroup_noothpath_cumlinacc)$coefficients["cum_linacc10000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_noothpath_cumlinacc)$coefficients["cum_linacc10000",2])

# Cumulative linacc by presence of CTE for pure football (no other sports or military)
donordat_footballonlynomilitary$cum_linacc10000 <- donordat_footballonlynomilitary$cum_linacc/10000
CTE_footballonlynomilitary_cumlinacc <- glm(CTE ~ cum_linacc10000 + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTE_footballonlynomilitary_cumlinacc)
exp(summary(CTE_footballonlynomilitary_cumlinacc)$coefficients["cum_linacc10000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_footballonlynomilitary_cumlinacc)$coefficients["cum_linacc10000",2])


# Cumulative linacc by severity of CTE for pure football (no other sports or military)
CTEgroup_footballonlynomilitary_cumlinacc <- glm(CTEgroup ~ cum_linacc10000 + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTEgroup_footballonlynomilitary_cumlinacc)
exp(summary(CTEgroup_footballonlynomilitary_cumlinacc)$coefficients["cum_linacc10000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_footballonlynomilitary_cumlinacc)$coefficients["cum_linacc10000",2])


# Sum linacc by presence of CTE for new dataset overall
CTE_sumlinacc <- glm(CTE ~ sum_linacc + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_sumlinacc)
exp(coef(CTE_sumlinacc))

# sum linacc by severity of CTE for all participants
CTEgroup_sumlinacc <- glm(CTEgroup ~ sum_linacc + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_sumlinacc)
exp(coef(CTEgroup_sumlinacc))

# Cumulative linacc by presence of CTE for annals dataset 
CTE_cumlinacc_annals <- glm(CTE ~ cum_linacc + agedeath, data=donordat_annals, family=binomial(link="logit"))
summary(CTE_cumlinacc_annals)
exp(coef(CTE_cumlinacc_annals))

# Cumulative linacc by presence of CTE for postannals dataset 
CTE_cumlinacc_postannals <- glm(CTE ~ cum_linacc + agedeath, data=donordat_postannals, family=binomial(link="logit"))
summary(CTE_cumlinacc_postannals)
exp(coef(CTE_cumlinacc_postannals))

# Cumulative linacc by CTE severity for new dataset overall
CTEgroup_cumlinacc <- glm(CTEgroup ~ cum_linacc + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_cumlinacc)
exp(coef(CTEgroup_cumlinacc))

# Sum linacc by CTE severity for new dataset overall
CTEgroup_sumlinacc <- glm(CTEgroup ~ sum_linacc + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_sumlinacc)
exp(coef(CTEgroup_sumlinacc))

# Sum rot by CTE severity for new dataset overall
CTEgroup_sumrot <- glm(CTEgroup ~ sum_linacc + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_sumrot)
exp(coef(CTEgroup_sumrot))

# Cumulative linacc by CTE Stage for new dataset overall
CTEStage_cumlinacc <- multinom(CTEStage ~ cum_linacc + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
summary(CTEStage_cumlinacc)
exp(coef(CTEStage_cumlinacc))

# Sum linacc by CTE Stage for new dataset overall
CTEStage_sumlinacc <- multinom(CTEStage ~ sum_linacc + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
summary(CTEStage_sumlinacc)
exp(coef(CTEStage_sumlinacc))

# test freq
years_freq <- glm(footyrs ~ cum_freq, data=donordat)
summary(years_freq)
exp(coef(years_freq))

# Cumulative freq by presence of CTE for new dataset overall per 1000 hits
donordat$cum_freq1000 <- donordat$cum_freq/1000
CTE_cumfreq <- glm(CTE ~ cum_freq1000 + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_cumfreq)
exp(summary(CTE_cumfreq)$coefficients["cum_freq1000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_cumfreq)$coefficients["cum_freq1000",2])


# Cumulative freq by severity of CTE for all participants
CTEgroup_freq <- glm(CTEgroup ~ cum_freq1000 + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_freq)
exp(summary(CTEgroup_freq)$coefficients["cum_freq1000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_freq)$coefficients["cum_freq1000",2])


# Cumulative freq by presence of CTE  for new dataset overall
CTEStage_freq <- multinom(CTEStage ~ cum_freq + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
summary(CTEStage_freq)
exp(coef(CTEStage_freq))

# Cumulative freq by presence of CTE for football only and no military per 1000 hits
donordat_footballonlynomilitary$cum_freq1000 <- donordat_footballonlynomilitary$cum_freq/1000
CTE_footballonlynomilitary_cumfreq <- glm(CTE ~ cum_freq1000 + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTE_footballonlynomilitary_cumfreq)
exp(summary(CTE_footballonlynomilitary_cumfreq)$coefficients["cum_freq1000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_footballonlynomilitary_cumfreq)$coefficients["cum_freq1000",2])

# Cumulative freq by severity of CTE for football only and no military per 1000 hits
CTEgroup_footballonlynomilitary_freq <- glm(CTEgroup ~ cum_freq1000 + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTEgroup_footballonlynomilitary_freq)
exp(summary(CTEgroup_footballonlynomilitary_freq)$coefficients["cum_freq1000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_footballonlynomilitary_freq)$coefficients["cum_freq1000",2])

# Cumulative freq by presence of CTE for no other neurodegenerative disease per 1000 hits
donordat_noothpath$cum_freq1000 <- donordat_noothpath$cum_freq/1000
CTE_noothpath_cumfreq <- glm(CTE ~ cum_freq1000 + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTE_noothpath_cumfreq)
exp(summary(CTE_noothpath_cumfreq)$coefficients["cum_freq1000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_noothpath_cumfreq)$coefficients["cum_freq1000",2])

# Cumulative freq by severity of CTE for no other neurodegenerative disease per 1000 hits
CTEgroup_noothpath_freq <- glm(CTEgroup ~ cum_freq1000 + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTEgroup_noothpath_freq)
exp(summary(CTEgroup_noothpath_freq)$coefficients["cum_freq1000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_noothpath_freq)$coefficients["cum_freq1000",2])

# test rot
years_cumrot <- glm(footyrs ~ cum_rot, data=donordat)
summary(years_cumrot)
exp(coef(years_cumrot))

# Cumulative rot by presence of CTE for new dataset overall
CTE_cumrot <- glm(CTE ~ cum_rot + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_cumrot)
exp(coef(CTE_cumrot))

# Cumulative freq by presence of CTE for new dataset overall per 1000000
donordat$cum_rot1000000 <- donordat$cum_rot/1000000
CTE_cumrot <- glm(CTE ~ cum_rot1000000 + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_cumrot)
exp(summary(CTE_cumrot)$coefficients["cum_rot1000000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_cumrot)$coefficients["cum_rot1000000",2])


# Sum rot by presence of CTE for new dataset overall
CTE_sumrot <- glm(CTE ~ sum_rot + agedeath, data=donordat)
summary(CTE_sumrot)
exp(coef(CTE_sumrot))

# Cumulative rot by severity of CTE for all participants per 1000000
CTEgroup_cumrot <- glm(CTEgroup ~ cum_rot1000000 + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_cumrot)
exp(summary(CTEgroup_cumrot)$coefficients["cum_rot1000000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_cumrot)$coefficients["cum_rot1000000",2])

# Cumulative freq by presence of CTE for no other contact sport or military overall per 1000000
donordat_footballonlynomilitary$cum_rot1000000 <- donordat_footballonlynomilitary$cum_rot/1000000
CTE_footballonlynomilitary_cumrot <- glm(CTE ~ cum_rot1000000 + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTE_footballonlynomilitary_cumrot)
exp(summary(CTE_footballonlynomilitary_cumrot)$coefficients["cum_rot1000000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_footballonlynomilitary_cumrot)$coefficients["cum_rot1000000",2])

# Cumulative rot by severity of CTE for no other contact sport or military per 1000000
CTEgroup_footballonlynomilitary_cumrot <- glm(CTEgroup ~ cum_rot1000000 + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTEgroup_footballonlynomilitary_cumrot)
exp(summary(CTEgroup_footballonlynomilitary_cumrot)$coefficients["cum_rot1000000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_footballonlynomilitary_cumrot)$coefficients["cum_rot1000000",2])

# Cumulative freq by presence of CTE for no other neurodegenerative disease overall per 1000000
donordat_noothpath$cum_rot1000000 <- donordat_noothpath$cum_rot/1000000
CTE_noothpath_cumrot <- glm(CTE ~ cum_rot1000000 + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTE_noothpath_cumrot)
exp(summary(CTE_noothpath_cumrot)$coefficients["cum_rot1000000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_noothpath_cumrot)$coefficients["cum_rot1000000",2])

# Cumulative rot by severity of CTE for no other neurodegenerative disease per 1000000
CTEgroup_noothpath_cumrot <- glm(CTEgroup ~ cum_rot1000000 + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTEgroup_noothpath_cumrot)
exp(summary(CTEgroup_noothpath_cumrot)$coefficients["cum_rot1000000",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_noothpath_cumrot)$coefficients["cum_rot1000000",2])

# Cumulative rot by presence of CTE  for new dataset overall
CTEStage_cumrot <- multinom(CTEStage ~ cum_rot + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
summary(CTEStage_cumrot)
exp(coef(CTEStage_cumrot))

# Sum rot by presence of CTE  for new dataset overall
CTEStage_sumrot <- multinom(CTEStage ~ sum_rot + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
summary(CTEStage_sumrot)
exp(coef(CTEStage_sumrot))

# Sum rot by severity of CTE for all participants
CTEgroup_sumrot <- glm(CTEgroup ~ sum_rot + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_cumlinacc)
exp(coef(CTEgroup_cumlinacc))

# Concussions  by presence of CTE for all participants
CTE_conc <- glm(CTE ~ Concussion_ + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_conc)
exp(summary(CTE_conc)$coefficients["Concussion_",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_conc)$coefficients["Concussion_",2])

# Concussions by severity of CTE for all participants
CTEgroup_conc <- glm(CTEgroup ~ Concussion_ + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_conc)
exp(summary(CTEgroup_conc)$coefficients["Concussion_",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_conc)$coefficients["Concussion_",2])

# Position by presence of CTE for all participants
CTE_pos <- glm(CTE ~ factor(poshigh) + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_pos)
exp(coef(CTE_pos))
exp(confint(CTE_pos))

# Position by severity of CTE for all participants
CTEgroup_pos <- glm(CTEgroup ~ factor(poshigh) + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_pos)
exp(coef(CTEgroup_pos))
exp(confint(CTEgroup_pos))

# Concussions by presence of CTE for no other contact sport or military
CTE_footballonlynomilitary_conc <- glm(CTE ~ Concussion_ + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTE_footballonlynomilitary_conc)
exp(summary(CTE_footballonlynomilitary_conc)$coefficients["Concussion_",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_footballonlynomilitary_conc)$coefficients["Concussion_",2])

# Concussions by severity of CTE for no other contact sport or military
CTEgroup_footballonlynomilitary_conc <- glm(CTEgroup ~ Concussion_ + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTEgroup_footballonlynomilitary_conc)
exp(summary(CTEgroup_footballonlynomilitary_conc)$coefficients["Concussion_",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_footballonlynomilitary_conc)$coefficients["Concussion_",2])

# Position by presence of CTE for no other contact sport or military
CTE_footballonlynomilitary_pos <- glm(CTE ~ poshighspeedbin + agedeath, data=donordat_footballonlynomilitary, family=binomial(link="logit"))
summary(CTE_footballonlynomilitary_pos)
exp(summary(CTE_footballonlynomilitary_pos)$coefficients["poshighspeedbin",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_footballonlynomilitary_pos)$coefficients["poshighspeedbin",2])

# Position by severity of CTE for no other contact sport or military
CTEgroup_footballonlynomilitary_pos <- glm(CTEgroup ~ poshighspeedbin + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_footballonlynomilitary_pos)
exp(summary(CTEgroup_footballonlynomilitary_pos)$coefficients["poshighspeedbin",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_footballonlynomilitary_pos)$coefficients["poshighspeedbin",2])

# Concussions  by presence of CTE for no other pathology
CTE_noothpath_conc <- glm(CTE ~ Concussion_ + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTE_noothpath_conc)
exp(summary(CTE_noothpath_conc)$coefficients["Concussion_",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_noothpath_conc)$coefficients["Concussion_",2])

# Concussions by severity of CTE for no other pathology
CTEgroup_noothpath_conc <- glm(CTEgroup ~ Concussion_ + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTEgroup_noothpath_conc)
exp(summary(CTEgroup_noothpath_conc)$coefficients["Concussion_",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_noothpath_conc)$coefficients["Concussion_",2])

# Position by presence of CTE for no other pathology
CTE_noothpath_pos <- glm(CTE ~ poshighspeedbin + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTE_noothpath_pos)
exp(summary(CTE_noothpath_pos)$coefficients["poshighspeedbin",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_noothpath_pos)$coefficients["poshighspeedbin",2])

# Position by severity of CTE for no other pathology
CTEgroup_noothpath_pos <- glm(CTEgroup ~ poshighspeedbin + agedeath, data=donordat_noothpath, family=binomial(link="logit"))
summary(CTEgroup_noothpath_pos)
exp(summary(CTEgroup_noothpath_pos)$coefficients["poshighspeedbin",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_noothpath_pos)$coefficients["poshighspeedbin",2])

# Position by NFT burden for all participants
semiquant11_pos <- lm(sumsemiquant11 ~ factor(poshigh) + agedeath, data=donordat, family=binomial(link="logit"))
summary(semiquant11_pos)
exp(coef(semiquant11_pos))
exp(confint(semiquant11_pos))

# Speed position by presence of CTE for all participants
CTE_skpos <- glm(CTE ~ poshighspeedbin + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTE_skpos)
exp(summary(CTE_skpos)$coefficients["poshighspeedbin",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTE_skpos)$coefficients["poshighspeedbin",2])

# Speed position by severity of CTE for all participants
CTEgroup_skpos <- glm(CTEgroup ~ poshighspeedbin + agedeath, data=donordat, family=binomial(link="logit"))
summary(CTEgroup_skpos)
exp(summary(CTEgroup_skpos)$coefficients["poshighspeedbin",1] + 
      +     qnorm(c(0.025,0.5,0.975)) * summary(CTEgroup_skpos)$coefficients["poshighspeedbin",2])



# Show NFT tables
donordat %>%
  group_by(CTEStage) %>%
  summarize_at(vars(sumsemiquant11), list(mean,sd,length,min,max))


# Duration by semi quant tau for new dataset overall
tau_yrs <- lm(sumsemiquant ~ footyrs + agedeath, data=donordat)
summary(tau_yrs)
confint(tau_yrs,'footyrs')

tau8_yrs <- lm(sumsemiquant8 ~ footyrs + agedeath, data=donordat)
summary(tau8_yrs)

tau11_yrs <- lm(sumsemiquant11 ~ footyrs + agedeath, data=donordat)
summary(tau11_yrs)
confint(tau11_yrs,'footyrs')

# Cumulative freq by semi quant tau for new dataset overall
tau_cumfreq <- lm(sumsemiquant ~ cum_freq1000 + agedeath, data=donordat)
summary(tau_cumfreq)
confint(tau_cumfreq,'cum_freq1000')


tau8_cumfreq <- lm(sumsemiquant8 ~ cum_freq1000 + agedeath, data=donordat)
summary(tau8_cumfreq)

tau11_cumfreq <- lm(sumsemiquant11 ~ cum_freq1000 + agedeath, data=donordat)
summary(tau11_cumfreq)
confint(tau11_cumfreq,'cum_freq1000')

# Cumulative linacc by semi quant tau for new dataset overall
tau_cumlinacc <- lm(sumsemiquant ~ cum_linacc10000 + agedeath, data=donordat)
summary(tau_cumlinacc)
confint(tau_cumlinacc,'cum_linacc10000')

tau8_cumlinacc <- lm(sumsemiquant8 ~ cum_linacc10000 + agedeath, data=donordat)
summary(tau8_cumlinacc)

tau11_cumlinacc <- lm(sumsemiquant11 ~ cum_linacc10000 + agedeath, data=donordat)
summary(tau11_cumlinacc)
confint(tau11_cumlinacc,'cum_linacc10000')

# Cumulative rot by semi quant tau for new dataset overall
tau_cumrot <- lm(sumsemiquant ~ cum_rot1000000 + agedeath, data=donordat)
summary(tau_cumrot)
confint(tau_cumrot,'cum_rot1000000')

tau8_cumrot <- lm(sumsemiquant8 ~ cum_rot1000000 + agedeath, data=donordat)
summary(tau8_cumrot)

tau11_cumrot <- lm(sumsemiquant11 ~ cum_rot1000000 + agedeath, data=donordat)
summary(tau11_cumrot)
confint(tau11_cumrot,'cum_rot1000000')

# Position binary by semi quant tau
tau_posbin <- lm(sumsemiquant ~ poshighspeedbin + agedeath, data=donordat)
summary(tau_posbin)
confint(tau_posbin,'poshighspeedbin')

tau11_posbin <- lm(sumsemiquant11 ~ poshighspeedbin + agedeath, data=donordat)
summary(tau11_posbin)
confint(tau11_posbin,'poshighspeedbin')

# Position by semi quant tau
tau_pos <- lm(sumsemiquant ~ poshigh + agedeath, data=donordat)
summary(tau_pos)
confint(tau_pos,'poshigh')

tau11_pos <- lm(sumsemiquant11 ~ poshighspeedbin + agedeath, data=donordat)
summary(tau11_pos)
confint(tau11_pos,'poshigh')

# Concussion by semi quant tau
tau_conc <- lm(sumsemiquant ~ Concussion_ + agedeath, data=donordat)
summary(tau_conc)
confint(tau_conc,'Concussion_')

tau11_conc <- lm(sumsemiquant11 ~ Concussion_ + agedeath, data=donordat)
summary(tau11_conc)
confint(tau11_conc,'Concussion_')

library(rcompanion)

compareLM(tau11_pos,tau11_yrs,tau11_cumfreq,
          tau11_cumlinacc,tau11_cumrot)

compareLM(tau_pos,tau_yrs,tau_cumfreq,
          tau_cumlinacc,tau_cumrot)

# Compare models based on Akaike's Information Criterion
AIC(CTEStage_yrs)
AIC(CTEStage_cumfreq)
AIC(CTEStage_cumlinacc)
AIC(CTEStage_cumrot)

# Calculate relative likelihood of higher AIC model
exp((AIC(CTEStage_yrs) - AIC(CTEStage_freq))/2)
exp((AIC(CTEStage_cumlinacc) - AIC(CTEStage_yrs))/2)
exp((AIC(CTEStage_cumrot) - AIC(CTEStage_yrs))/2)

# Compare models based on Bayesian Information Criterion
BIC(CTEStage_yrs)
BIC(CTEStage_cumfreq)
BIC(CTEStage_cumlinacc)
BIC(CTEStage_cumrot)

BIC(CTE_yrs)
BIC(CTE_cumfreq)
BIC(CTE_cumlinacc)
BIC(CTE_cumrot)
BIC(CTE_skpos)

BIC(CTE_pureCTE_yrs)
BIC(CTE_noothpath_cumfreq)
BIC(CTE_noothpath_cumlinacc)
BIC(CTE_noothpath_cumrot)

BIC(CTE_footballonlynomilitary_yrs)
BIC(CTE_footballonlynomilitary_cumfreq)
BIC(CTE_footballonlynomilitary_cumlinacc)
BIC(CTE_footballonlynomilitary_cumrot)

BIC(CTEgroup_yrs)
BIC(CTEgroup_freq)
BIC(CTEgroup_cumlinacc)
BIC(CTEgroup_cumrot)
BIC(CTEgroup_skpos)

BIC(CTEgroup_noothpath_yrs)
BIC(CTEgroup_noothpath_freq)
BIC(CTEgroup_noothpath_cumlinacc)
BIC(CTEgroup_noothpath_cumrot)

BIC(CTEgroup_footballonlynomilitary_yrs)
BIC(CTEgroup_footballonlynomilitary_freq)
BIC(CTEgroup_footballonlynomilitary_cumlinacc)
BIC(CTEgroup_footballonlynomilitary_cumrot)


############### CROSS VALIDATION#################


#### Binary responses

# Cost function for binomial responses
cost <- function(r, pi = 0) mean(abs(r-pi) > 0.5)

# CTE comparisons
cv.glm(data.frame(CTE_yrs$model), CTE_yrs, K = 10)$delta[1]
cv.glm(data.frame(CTE_cumfreq$model), CTE_cumfreq, K = 10)$delta[1]
cv.glm(data.frame(CTE_cumlinacc$model), CTE_cumlinacc, K = 10)$delta[1]
cv.glm(data.frame(CTE_cumrot$model), CTE_cumrot, K = 10)$delta[1]
cv.glm(data.frame(CTE_skpos$model), CTE_skpos, K = 10)$delta[1]

cv.glm(data.frame(CTE_footballonlynomilitary_yrs$model), CTE_footballonlynomilitary_yrs, K = 10)$delta[1]
cv.glm(data.frame(CTE_footballonlynomilitary_cumfreq$model), CTE_footballonlynomilitary_cumfreq, K = 10)$delta[1]
cv.glm(data.frame(CTE_footballonlynomilitary_cumlinacc$model), CTE_footballonlynomilitary_cumlinacc, K = 10)$delta[1]
cv.glm(data.frame(CTE_footballonlynomilitary_cumrot$model), CTE_footballonlynomilitary_cumrot, K = 10)$delta[1]

cv.glm(data.frame(CTE_pureCTE_yrs$model), CTE_pureCTE_yrs, K = 10)$delta[1]
cv.glm(data.frame(CTE_noothpath_cumfreq$model), CTE_noothpath_cumfreq, K = 10)$delta[1]
cv.glm(data.frame(CTE_noothpath_cumlinacc$model), CTE_noothpath_cumlinacc, K = 10)$delta[1]
cv.glm(data.frame(CTE_noothpath_cumrot$model), CTE_noothpath_cumrot, K = 10)$delta[1]

# CTE group comparisons
cv.glm(data.frame(CTEgroup_yrs$model), CTEgroup_yrs, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_freq$model), CTEgroup_freq, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_cumlinacc$model), CTEgroup_cumlinacc, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_cumrot$model), CTEgroup_cumrot, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_skpos$model), CTEgroup_skpos, K = 10)$delta[1]

cv.glm(data.frame(CTEgroup_footballonlynomilitary_yrs$model), CTEgroup_footballonlynomilitary_yrs, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_footballonlynomilitary_freq$model), CTEgroup_footballonlynomilitary_freq, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_footballonlynomilitary_cumlinacc$model), CTEgroup_footballonlynomilitary_cumlinacc, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_footballonlynomilitary_cumrot$model), CTEgroup_footballonlynomilitary_cumrot, K = 10)$delta[1]

cv.glm(data.frame(CTEgroup_noothpath_yrs$model), CTEgroup_noothpath_yrs, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_noothpath_freq$model), CTEgroup_noothpath_freq, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_noothpath_cumlinacc$model), CTEgroup_noothpath_cumlinacc, K = 10)$delta[1]
cv.glm(data.frame(CTEgroup_noothpath_cumrot$model), CTEgroup_noothpath_cumrot, K = 10)$delta[1]

###############################################

#####MULTINOMIAL SUMMARY FUNCTION 
multinom_summary <- function(model, sigLevel = 0.05){
  #Uses the regular summary function
  smn <- summary(model)
  #calculates p-values
  pvals <- apply(abs(smn$coefficients/smn$standard.errors), 1:2, function(x)pnorm(x, lower.tail = FALSE))
  #determines if p-value is significant
  sig <- pvals < sigLevel
  #Output
  list(coefficients = smn$coefficients, se = smn$standard.errors, `p-value` = pvals, significant = sig)
}


#####MULTINOMIAL CV FUNCTION
multinom.cv <- function(form, data, K = 10){
  #extract variables from formula
  av <- all.vars(form)
  #Remove missing
  nd = data[av] %>%
    na.omit
  #split data into k groups
  nd$sample = sample(1:K, nrow(nd), replace = TRUE)
  #for each group run validation
  map_dbl(1:K, function(x){
    #exclude group x
    train <- filter(nd, sample != x)
    #include group x
    test <- filter(nd, sample == x)
    #fit multinom on training data
    multmod <- multinom(form, data = train, cost = cost, K = K, trace = F)
    #run cross-entropy cost function for test data
    sum(
      -2 * log((dummy_cols(test[all.vars(form)[1]])[,-1] *fitted(multmod, test)) %>% rowSums())
    )
  }) %>%
    #return average loss
    sum()/nrow(nd)
}

#### CV for multinomial response

multinom.cv(form = CTEStage ~ footyrs + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
multinom.cv(form = CTEStage ~ cum_linacc + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
multinom.cv(form = CTEStage ~ cum_freq + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
multinom.cv(form = CTEStage ~ cum_rot + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))



# Because of missingness these models are valid
multinom.cv(form = CTEStage ~ sum_linacc + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))
multinom.cv(form = CTEStage ~ sum_rot + agedeath, data=donordat %>% mutate(CTEStage = factor(CTEStage, levels = 0:4)))







# Calculate strength of relationship for BIC models
BIC(CTEStage_cumfreq) - BIC(CTEStage_yrs)
BIC(CTEStage_yrs) - BIC(CTEStage_cumlinacc)
BIC(CTEStage_yrs) - BIC(CTEStage_cumrot)

# ROC library
install.packages("pROC")
library(pROC)

# ROC curves for CTE status binary
status.roc.list <- roc(CTE ~ footyrs + cum_freq + cum_linacc + cum_rot, data = donordat)
rocCTEfootyrs <- roc(CTE ~ footyrs, data=donordat)
rocCTEcum_freq <- roc(CTE ~ cum_freq, data=donordat)
rocCTEcum_linacc <- roc(CTE ~ cum_linacc, data=donordat)
rocCTEcum_rot <- roc(CTE ~ cum_rot, data=donordat)
rocCTE_skpos <- roc(CTE ~ poshighspeedbin, data=donordat)

roc.test(rocCTEfootyrs, rocCTEcum_freq, method=c("bootstrap"))
roc.test(rocCTEfootyrs, rocCTEcum_linacc, method=c("bootstrap"))
roc.test(rocCTEfootyrs, rocCTEcum_rot, method=c("bootstrap"))
roc.test(rocCTEfootyrs, rocCTE_skpos, method=c("bootstrap"))

roc.test(rocCTEcum_freq, rocCTEcum_linacc, method=c("bootstrap"))
roc.test(rocCTEcum_freq, rocCTEcum_rot, method=c("bootstrap"))
roc.test(rocCTEcum_linacc, rocCTEcum_rot, method=c("bootstrap"))


rocCTEfootballonlynomilitaryfootyrs <- roc(CTE ~ footyrs, data=donordat_footballonlynomilitary)
rocCTEfootballonlynomilitarycum_freq <- roc(CTE ~ cum_freq, data=donordat_footballonlynomilitary)
rocCTEfootballonlynomilitarycum_linacc <- roc(CTE ~ cum_linacc, data=donordat_footballonlynomilitary)
rocCTEfootballonlynomilitarycum_rot <- roc(CTE ~ cum_rot, data=donordat_footballonlynomilitary)

roc.test(rocCTEfootballonlynomilitaryfootyrs, rocCTEfootballonlynomilitarycum_freq, method=c("bootstrap"))
roc.test(rocCTEfootballonlynomilitaryfootyrs, rocCTEfootballonlynomilitarycum_linacc, method=c("bootstrap"))
roc.test(rocCTEfootballonlynomilitaryfootyrs, rocCTEfootballonlynomilitarycum_rot, method=c("bootstrap"))

roc.test(rocCTEfootballonlynomilitarycum_freq, rocCTEfootballonlynomilitarycum_linacc, method=c("bootstrap"))
roc.test(rocCTEfootballonlynomilitarycum_freq, rocCTEfootballonlynomilitarycum_rot, method=c("bootstrap"))
roc.test(rocCTEfootballonlynomilitarycum_linacc, rocCTEfootballonlynomilitarycum_rot, method=c("bootstrap"))


rocCTEnoothpathfootyrs <- roc(CTE ~ footyrs, data=donordat_noothpath)
rocCTEnoothpathcum_freq <- roc(CTE ~ cum_freq, data=donordat_noothpath)
rocCTEnoothpathcum_linacc <- roc(CTE ~ cum_linacc, data=donordat_noothpath)
rocCTEnoothpathcum_rot <- roc(CTE ~ cum_rot, data=donordat_noothpath)

roc.test(rocCTEnoothpathfootyrs, rocCTEnoothpathcum_freq, method=c("bootstrap"))
roc.test(rocCTEnoothpathfootyrs, rocCTEnoothpathcum_linacc, method=c("bootstrap"))
roc.test(rocCTEnoothpathfootyrs, rocCTEnoothpathcum_rot, method=c("bootstrap"))

roc.test(rocCTEnoothpathcum_freq, rocCTEnoothpathcum_linacc, method=c("bootstrap"))
roc.test(rocCTEnoothpathcum_freq, rocCTEnoothpathcum_rot, method=c("bootstrap"))
roc.test(rocCTEnoothpathcum_linacc, rocCTEnoothpathcum_rot, method=c("bootstrap"))

# extract auc
status.roc.list %>% 
  map(~tibble(AUC = .x$auc)) %>% 
  bind_rows(.id = "name") -> status.data.auc

exposurelegendlabels = c("Duration of Play", "Total Hits (CHII)", "Total G-Force (CHII-G)", "Total Rotational Force (CHII-R)")

# generate labels 
status.data.auc %>% 
  mutate(label_long=paste0(exposurelegendlabels,",  AUC = ",paste(round(AUC,2))),
         label_AUC=paste0("AUC = ",paste(round(AUC,2)))) -> status.data.labels

CTEStatusROC <- ggroc(status.roc.list, size=0.6) + 
  ggtitle("CTE Status") + 
  labs(color='Exposure Measures') +
  theme_bw() + 
  scale_color_discrete(labels=status.data.labels$label_long) +
  theme(axis.line = element_line(colour = "black", size=1),
        panel.border = element_blank(), 
        panel.background = element_blank(),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        plot.title = element_text(face="bold", size=10, hjust = 0.5, vjust = -1),
        legend.title = element_text(size=7, face="bold", hjust = 0.5),
        legend.text=element_text(size=5),
        axis.title.x = element_text(face="bold", size=8),
        axis.title.y = element_text(face="bold", size=8),
        axis.text = element_text(size=7),
        legend.background = element_rect(size=0.5, linetype="solid", color ="black"),
        legend.justification=c(1,0),
        legend.position=c(0.9,0.1),
        legend.key.width=unit(0.5,"line"),
        legend.key.height=unit(0.6,"line")) 


ggsave(filename="C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Drafts/CTE Status ROC.png", plot=CTEStatusROC, device="png",
       width = 7.5,
       height = 6,
       units = c("in"))


# ROC curves for CTE severity binary
sev.roc.list <- roc(CTEgroup ~ footyrs + cum_freq + cum_linacc + cum_rot, data = donordat)

rocCTEgroupfootyrs <- roc(CTEgroup ~ footyrs, data=donordat)
rocCTEgroupcum_freq <- roc(CTEgroup ~ cum_freq, data=donordat)
rocCTEgroupcum_linacc <- roc(CTEgroup ~ cum_linacc, data=donordat)
rocCTEgroupcum_rot <- roc(CTEgroup ~ cum_rot, data=donordat)

roc.test(rocCTEgroupfootyrs, rocCTEgroupcum_freq, method=c("bootstrap"))
roc.test(rocCTEgroupfootyrs, rocCTEgroupcum_linacc, method=c("bootstrap"))
roc.test(rocCTEgroupfootyrs, rocCTEgroupcum_rot, method=c("bootstrap"))

roc.test(rocCTEgroupcum_freq, rocCTEcum_linacc, method=c("bootstrap"))
roc.test(rocCTEgroupcum_freq, rocCTEcum_rot, method=c("bootstrap"))
roc.test(rocCTEgroupcum_linacc, rocCTEgroupcum_rot, method=c("bootstrap"))


rocCTEgroupfootballonlynomilitaryfootyrs <- roc(CTEgroup ~ footyrs, data=donordat_footballonlynomilitary)
rocCTEgroupfootballonlynomilitarycum_freq <- roc(CTEgroup ~ cum_freq, data=donordat_footballonlynomilitary)
rocCTEgroupfootballonlynomilitarycum_linacc <- roc(CTEgroup ~ cum_linacc, data=donordat_footballonlynomilitary)
rocCTEgroupfootballonlynomilitarycum_rot <- roc(CTEgroup ~ cum_rot, data=donordat_footballonlynomilitary)

roc.test(rocCTEgroupfootballonlynomilitaryfootyrs, rocCTEgroupfootballonlynomilitarycum_freq, method=c("bootstrap"))
roc.test(rocCTEgroupfootballonlynomilitaryfootyrs, rocCTEgroupfootballonlynomilitarycum_linacc, method=c("bootstrap"))
roc.test(rocCTEgroupfootballonlynomilitaryfootyrs, rocCTEgroupfootballonlynomilitarycum_rot, method=c("bootstrap"))

roc.test(rocCTEgroupfootballonlynomilitarycum_freq, rocCTEgroupfootballonlynomilitarycum_linacc, method=c("bootstrap"))
roc.test(rocCTEgroupfootballonlynomilitarycum_freq, rocCTEgroupfootballonlynomilitarycum_rot, method=c("bootstrap"))
roc.test(rocCTEgroupfootballonlynomilitarycum_linacc, rocCTEgroupfootballonlynomilitarycum_rot, method=c("bootstrap"))


rocCTEgroupnoothpathfootyrs <- roc(CTE ~ footyrs, data=donordat_noothpath)
rocCTEgroupnoothpathcum_freq <- roc(CTE ~ cum_freq, data=donordat_noothpath)
rocCTEgroupnoothpathcum_linacc <- roc(CTE ~ cum_linacc, data=donordat_noothpath)
rocCTEgroupnoothpathcum_rot <- roc(CTE ~ cum_rot, data=donordat_noothpath)

roc.test(rocCTEgroupnoothpathfootyrs, rocCTEgroupnoothpathcum_freq, method=c("bootstrap"))
roc.test(rocCTEgroupnoothpathfootyrs, rocCTEgroupnoothpathcum_linacc, method=c("bootstrap"))
roc.test(rocCTEgroupnoothpathfootyrs, rocCTEgroupnoothpathcum_rot, method=c("bootstrap"))

roc.test(rocCTEgroupnoothpathcum_freq, rocCTEgroupnoothpathcum_linacc, method=c("bootstrap"))
roc.test(rocCTEgroupnoothpathcum_freq, rocCTEgroupnoothpathcum_rot, method=c("bootstrap"))
roc.test(rocCTEgroupnoothpathcum_linacc, rocCTEgroupnoothpathcum_rot, method=c("bootstrap"))

# extract auc
sev.roc.list %>% 
  map(~tibble(AUC = .x$auc)) %>% 
  bind_rows(.id = "name") -> sev.data.auc

# generate labels 
sev.data.auc %>% 
  mutate(label_long=paste0(exposurelegendlabels,", AUC = ",paste(round(AUC,2))),
         label_AUC=paste0("AUC = ",paste(round(AUC,2)))) -> sev.data.labels

CTESeverityROC <- ggroc(sev.roc.list, size=0.6) + 
  ggtitle("CTE Severity") + 
  labs(color='Exposure Measures') +
  theme_bw() + 
  scale_color_discrete(labels=sev.data.labels$label_long) +
  theme(axis.line = element_line(colour = "black", size=1),
        panel.border = element_blank(), 
        panel.background = element_blank(),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        plot.title = element_text(face="bold", size=10, hjust = 0.5, vjust = -1),
        legend.title = element_text(size=7, face="bold", hjust = 0.5),
        legend.text=element_text(size=5),
        axis.title.x = element_text(face="bold", size=8),
        axis.title.y = element_text(face="bold", size=8),
        axis.text = element_text(size=7),
        legend.background = element_rect(size=0.5, linetype="solid", color ="black"),
        legend.justification=c(1,0),
        legend.position=c(0.9,0.1),
        legend.key.width=unit(0.5,"line"),
        legend.key.height=unit(0.6,"line")) 


ggsave(filename="C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Drafts/CTE Severity ROC.png", plot=CTESeverityROC, device="png",
       width = 7.5,
       height = 6,
       units = c("in"))

# Create PEM figure 
FigureROC <- ggarrange(CTEStatusROC, CTESeverityROC,
                     labels = c("a", "b"),
                     font.label = list(size = 14),
                     vjust = 1.7,
                     hjust = -1.3,
                     ncol = 2, nrow = 1)
FigureROC <- annotate_figure(FigureROC, top = text_grob("Figure 2. ROC Curves for Exposure Measures as Predictors of CTE", 
                                      color = "black", face = "bold", size = 16))

ggsave(filename="C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Drafts/CTE Overall ROC.png", plot=FigureROC, device="png",
       width = 7.5,
       height = 3,
       units = c("in"))





##Create percent of athletes by exposure measures figure

#Create ceiling variable
donordat_completeCTE <- subset(donordat, !is.na(CTE))
donordat_completeCTE$ceiling_footyrs <- ceiling(donordat_completeCTE$footyrs)

# Center titles 
theme_update(plot.title = element_text(hjust = 0.5))

#basic histogram of years by CTEYN
ggplot(donordat_completeCTE, aes(ceiling(footyrs), fill=as.factor(CTE))) +
  geom_histogram(binwidth = 1) +
  labs(title="Number of Athletes with CTE by Years Played", x="Years Played", y="Number of Athletes") + 
  scale_fill_manual(breaks = c("0", "1"), 
                    values = c("green3", "red2"),
                    labels = c("No CTE", "CTE")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.9, 0.8))

# histogram percents of CTE by years

percents <- donordat_completeCTE %>% 
  group_by(footyrs,CTE) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))

ggplot(percents, aes(x = factor(footyrs), y = perc*100, fill = factor(CTE))) +
  geom_bar(stat="identity", width = 1) +
  labs(title="Percent of Athletes with CTE by Years Played", x="Years Played", y="Percent of Athletes") + 
  scale_fill_manual(breaks = c("0", "1"), 
                    values=c("#88CCEE", "red2"),
                    labels = c("No CTE", "CTE")) + 
  guides(fill=guide_legend(title=NULL))

#basic histogram of years by CTE Stage
Fig2A <- ggplot(donordat_completeCTE, aes(ceiling(footyrs), fill=as.factor(CTEStage))) +
  geom_histogram(binwidth = 1) +
  labs(#title="Number of Athletes with CTE by Years Played", 
    x="Years of Football Played", y="Number of Athletes") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.9, 0.8),
        panel.background = element_rect(fill="white"),
        axis.line = element_line(size = 0.5, linetype = 'solid', color = "black")) +
  scale_y_continuous(expand = c(0,0))  + 
  scale_x_continuous(expand = c(0,0), breaks = seq(1,33,by=1)) # Remove extra space around plot

# histogram (as factor) with percents of CTE Stage by years
# First, define the percent that each case makes up of the whole column

percentstage <- donordat_completeCTE %>%
  add_row(ceiling_footyrs = 32, CTEStage = NA) %>% 
  group_by(ceiling_footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Histogram as factor
Fig2B <- ggplot(percentstage, aes(x = factor(ceiling_footyrs), y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(#title="Figure 1. Percent of Athletes with CTE by Years of Football Played", 
    x="Years of Football Played", y="Percentage of Athletes Within Given Number of Years Played") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV"),
                    na.value="white") + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"), 
        panel.border = element_rect(color = "black", fill = NA, size = 1),
        axis.text.y = element_text(angle = 90, hjust=0.6),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid'),
        plot.title = element_text(face="bold", size=18, hjust = 0.5, vjust = 0)) + # Background white
  scale_y_continuous(expand = c(0,0),
                     breaks = c(0, 25, 50, 75, 100), 
                     labels = c("0%", "25%", "50%", "75%", "100%")) + 
  scale_x_discrete(expand = c(0,0)) # Remove extra space around plot


# Create PEM figure 
FigureHist <- ggarrange(Fig2A, Fig2B,
                       labels = c("a", "b"),
                       font.label = list(size = 18),
                       vjust = 1.5,
                       hjust = -.5,
                       ncol = 1, nrow = 2)
FigureHist <- annotate_figure(FigureHist, top = text_grob("Figure 1. Athlete CTE Status by Years of Football Played", 
                                                        color = "black", face = "bold", size = 16))

ggsave(filename="C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020/Drafts/CTE histogram.png", plot=FigureHist, device="png",
       width = 8.5,
       height = 12,
       units = c("in"))





## Select cases that only played football 
donordat_footballonly <- subset(donordat_completeCTE, OtherContactSport == 0)

#basic histogram of years by CTE Stage for football only
ggplot(donordat_footballonly, aes(ceiling(footyrs), fill=as.factor(CTEStage))) +
  geom_histogram(binwidth = 1) +
  labs(#title="Football as Only Contact Sport", 
    x="Years of Football Played", y="Number of Athletes") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.9, 0.8),
        panel.background = element_rect(fill="white"),
        axis.line = element_line(size = 0.5, linetype = 'solid', color = "black")) +
  scale_y_continuous(expand = c(0,0))  + 
  scale_x_continuous(expand = c(0,0), breaks = seq(1,33,by=1)) # Remove extra space around plot

# Define cases by percent for football only
percentstage_footballonly <- donordat_footballonly %>% 
  add_row(ceiling_footyrs = 32, CTEStage = NA) %>% 
  group_by(ceiling_footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Next, histogram by factor for football only
ggplot(percentstage_footballonly, aes(x = factor(ceiling_footyrs), y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(#title="Football as Only Contact Sport", 
    x="Years of Football Played", y="Percentage of Athletes Within Given Number of Years Played") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV"),
                    na.value="white") + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"), 
        panel.border = element_rect(color = "black", fill = NA, size = 1),
        axis.text.y = element_text(angle = 90, hjust=0.6),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid'),
        plot.title = element_text(face="bold", size=18, hjust = 0.5, vjust = 0)) + # Background white
  scale_y_continuous(expand = c(0,0),
                     breaks = c(0, 25, 50, 75, 100), 
                     labels = c("0%", "25%", "50%", "75%", "100%")) + 
  scale_x_discrete(expand = c(0,0)) # Remove extra space around plot



## Select cases that all played other contact sports 
donordat_othersport <- subset(donordat_completeCTE, OtherContactSport == 1)

#basic histogram of years by CTE Stage that all played other contact sports 
FigS1A <- ggplot(donordat_othersport, aes(ceiling(footyrs), fill=as.factor(CTEStage))) +
  geom_histogram(binwidth = 1) +
  labs(#title="Multiple Contact Sports", 
    x="", y="Number of Athletes") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = "none", #c(0.9, 0.8),
        panel.background = element_rect(fill="white"),
        axis.line = element_line(size = 0.5, linetype = 'solid', color = "black")) +
  scale_y_continuous(expand = c(0,0))  + 
  scale_x_continuous(expand = c(0,0), breaks = seq(1,33,by=1)) # Remove extra space around plot

# Define cases by percent that all played other contact sports 
percentstage_othersport <- donordat_othersport %>% 
  add_row(ceiling_footyrs = 24, CTEStage = NA) %>% 
  group_by(ceiling_footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Next, histogram by factor that all played other contact sports 
FigS1B <- ggplot(percentstage_othersport, aes(x = factor(ceiling_footyrs), y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(#title="Multiple Contact Sports", 
    x="", y="Percentage of Athletes Within Given Number of Years Played") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV"),
                    na.value="white") + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = "none", #c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"), 
        panel.border = element_rect(color = "black", fill = NA, size = 1),
        axis.text.y = element_text(angle = 90, hjust=0.6),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid'),
        plot.title = element_text(face="bold", size=18, hjust = 0.5, vjust = 0)) + # Background white
  scale_y_continuous(expand = c(0,0),
                     breaks = c(0, 25, 50, 75, 100), 
                     labels = c("0%", "25%", "50%", "75%", "100%")) + 
  scale_x_discrete(expand = c(0,0)) # Remove extra space around plot


## Select cases that played football with military exposure
donordat_military <- subset(donordat_completeCTE, milhx == 1,
                                            select=subjid:ceiling_footyrs)

#basic histogram of years by CTE Stage that played football with military exposure
FigS1C <- ggplot(donordat_military, aes(ceiling(footyrs), fill=as.factor(CTEStage))) +
  geom_histogram(binwidth = 1) +
  labs(#title="Multiple Contact Sports", 
    x="", y="Number of Athletes") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = "none", #c(0.9, 0.8),
        panel.background = element_rect(fill="white"),
        axis.line = element_line(size = 0.5, linetype = 'solid', color = "black")) +
  scale_y_continuous(expand = c(0,0))  + 
  scale_x_continuous(expand = c(0,0), breaks = seq(1,33,by=1)) # Remove extra space around plot

# Define cases by percent that played football with military exposure
percentstage_military <- donordat_military %>% 
  add_row(ceiling_footyrs = 26, CTEStage = NA) %>% 
  group_by(ceiling_footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Next, histogram by factor that played football with military exposure
FigS1D <- ggplot(percentstage_military, aes(x = factor(ceiling_footyrs), y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(#title="Multiple Contact Sports", 
    x="Years of Football Played", y="Percentage of Athletes Within Given Number of Years Played") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV"),
                    na.value="white") + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = "none", #c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"), 
        panel.border = element_rect(color = "black", fill = NA, size = 1),
        axis.text.y = element_text(angle = 90, hjust=0.6),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid'),
        plot.title = element_text(face="bold", size=18, hjust = 0.5, vjust = 0)) + # Background white
  scale_y_continuous(expand = c(0,0),
                     breaks = c(0, 25, 50, 75, 100), 
                     labels = c("0%", "25%", "50%", "75%", "100%")) + 
  scale_x_discrete(expand = c(0,0)) # Remove extra space around plot


## Select cases that only played football without military exposure
donordat_footballonly_nonmilitary <- subset(donordat_completeCTE, OtherContactSport == 0 & milhx == 0,
                                                  select=subjid:ceiling_footyrs)

#basic histogram of years by CTE Stage that all played other contact sports 
FigS1E <- ggplot(donordat_footballonly_nonmilitary, aes(ceiling(footyrs), fill=as.factor(CTEStage))) +
  geom_histogram(binwidth = 1) +
  labs(#title="Only Football, No Military", 
    x="", y="") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.8, 0.8),
        legend.text = element_text(size=20),
        panel.background = element_rect(fill="white"),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid'),
        axis.line = element_line(size = 0.5, linetype = 'solid', color = "black")) +
  scale_y_continuous(expand = c(0,0))  + 
  scale_x_continuous(expand = c(0,0), breaks = seq(1,33,by=1)) # Remove extra space around plot

# Define cases by percent that all played other contact sports 
percentstage_footballonly_nonmilitary <- donordat_footballonly_nonmilitary %>% 
  add_row(ceiling_footyrs = 32, CTEStage = NA) %>% 
  group_by(ceiling_footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Next, histogram by factor that all played other contact sports 
FigS1F <- ggplot(percentstage_footballonly_nonmilitary, aes(x = factor(ceiling_footyrs), y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(#title="Only Football, No Military", 
    x="", y="") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV"),
                    na.value="white") + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = "none", #c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"), 
        panel.border = element_rect(color = "black", fill = NA, size = 1),
        axis.text.y = element_text(angle = 90, hjust=0.6),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid'),
        plot.title = element_text(face="bold", size=18, hjust = 0.5, vjust = 0)) + # Background white
  scale_y_continuous(expand = c(0,0),
                     breaks = c(0, 25, 50, 75, 100), 
                     labels = c("0%", "25%", "50%", "75%", "100%")) + 
  scale_x_discrete(expand = c(0,0)) # Remove extra space around plot


## Select cases that only have CTE
donordat_noothpathFig <- subset(donordat_completeCTE, OtherContactSport == 0 & milhx == 0,
                                            select=subjid:ceiling_footyrs)

#basic histogram of years by CTE Stage of only pure
FigS1G <- ggplot(donordat_noothpathFig, aes(ceiling(footyrs), fill=as.factor(CTEStage))) +
  geom_histogram(binwidth = 1) +
  labs(#title="No other neuropathology", 
    x="", y="") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = "none", #c(0.9, 0.8),
        panel.background = element_rect(fill="white"),
        axis.line = element_line(size = 0.5, linetype = 'solid', color = "black")) +
  scale_y_continuous(expand = c(0,0))  + 
  scale_x_continuous(expand = c(0,0), breaks = seq(1,33,by=1)) # Remove extra space around plot

# Define cases by percent that have no other neuropathology besides CTE
percentstage_noothpathFig <- donordat_noothpathFig %>% 
  add_row(ceiling_footyrs = 32, CTEStage = NA) %>% 
  group_by(ceiling_footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Next, histogram by factor that have no other neuropathology besides CTE
FigS1H <- ggplot(percentstage_noothpathFig, aes(x = factor(ceiling_footyrs), y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(#title="No other neuropathology", 
    x="Years of Football Played", y="") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("#88CCEE", "#ff0000", "#800000", "#400000", "#000000"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV"),
                    na.value="white") + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = "none", #c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"), 
        panel.border = element_rect(color = "black", fill = NA, size = 1),
        axis.text.y = element_text(angle = 90, hjust=0.6),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid'),
        plot.title = element_text(face="bold", size=18, hjust = 0.5, vjust = 0)) + # Background white
  scale_y_continuous(expand = c(0,0),
                     breaks = c(0, 25, 50, 75, 100), 
                     labels = c("0%", "25%", "50%", "75%", "100%")) + 
  scale_x_discrete(expand = c(0,0)) # Remove extra space around plot

# Create PEM Supplement figure 
FigureOthSprt <- ggarrange(FigS1A, FigS1B,
                        labels = c("a", "b"),
                        font.label = list(size = 18),
                        vjust = 1.5,
                        hjust = -.5,
                        ncol = 1, nrow = 2)
FigureOthSprt <- annotate_figure(FigureOthSprt, top = text_grob("Played Other Contact Sports", 
                                                          color = "black", size = 20))

FigureMilitary <- ggarrange(FigS1C, FigS1D,
                           labels = c("c", "d"),
                           font.label = list(size = 18),
                           vjust = 1.5,
                           hjust = -.5,
                           ncol = 1, nrow = 2)
FigureMilitary <- annotate_figure(FigureMilitary, top = text_grob("Served in Military", 
                                                                color = "black", size = 20))

FigureOnlyFootballNoMilitary <- ggarrange(FigS1E, FigS1F,
                            labels = c("e", "f"),
                            font.label = list(size = 18),
                            vjust = 1.5,
                            hjust = -.5,
                            ncol = 1, nrow = 2)
FigureOnlyFootballNoMilitary <- annotate_figure(FigureOnlyFootballNoMilitary, top = text_grob("Only Football, No Military", 
               
                                                                                                                                                 color = "black", size = 20))
FigureOnlynoothpath <- ggarrange(FigS1G, FigS1H,
                                          labels = c("g", "h"),
                                          font.label = list(size = 18),
                                          vjust = 1.5,
                                          hjust = -.5,
                                          ncol = 1, nrow = 2)
FigureOnlynoothpath <- annotate_figure(FigureOnlynoothpath, top = text_grob("No Neuropathology Besides CTE", 
                                                                                              color = "black", size = 20))
# Create PEM figure 
FigureSupplement <- ggarrange(FigureOthSprt, FigureOnlyFootballNoMilitary, FigureMilitary, FigureOnlynoothpath,
                        ncol = 2, nrow = 2)
FigureSupplement <- annotate_figure(FigureSupplement, top = text_grob("Supplemental Figure 1. Athlete CTE Status by Years of Football Played for Subgroups", 
                                                          color = "black", face = "bold", size = 25))


ggsave(filename="C:/Users/dhd10/Dropbox (Personal)/Personal/Papers/Exposure/Personal PEM 2020//Drafts/CTE Supplement histogram.png", plot=FigureSupplement, device="png",
       width = 16,
       height = 24,
       units = c("in"))



## Select cases without military exposure
donordat_nonmilitary <- subset(donordat_completeCTE, milhx == 0,
                                     select=subjid:ceiling_footyrs)

# Define cases by percent for those without military exposure
percentstage_nonmilitary <- donordat_nonmilitary %>% 
  group_by(ceiling_footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Next, histogram by factor those without military exposure
ggplot(percentstage_nonmilitary, aes(x = factor(ceiling_footyrs), y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(title="Percent of Athletes (Non-Military) with CTE, by Years of Football Played", x="Years of Football Played", y="Percent of Athletes Within Each Year") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("green3", "red1", "red2", "red3", "red4"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"), 
        panel.border = element_rect(color = "black", fill = NA, size = 1),
        axis.text.y = element_text(angle = 90, hjust=0.6),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid')) + # Background white
  scale_y_continuous(expand = c(0,0),
                     breaks = c(0, 25, 50, 75, 100), 
                     labels = c("0%", "25%", "50%", "75%", "100%")) + 
  scale_x_discrete(expand = c(0,0)) # Remove extra space around plot




# histogram (as continuous) with percents of CTE Stage by years
# First, define the percent that each case makes up of the whole column

percentstage <- donordat_completeCTE %>% 
  group_by(footyrs,CTEStage) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count)) 

# Histogram as continuous
ggplot(percentstage, aes(x = footyrs, y = perc*100, fill = factor(CTEStage))) +
  geom_bar(stat="identity", width = 1) +
  labs(title="Percent of Athletes with CTE by Years Played", x="Years of Football Played", y="Percent of Athletes") + 
  scale_fill_manual(breaks = c("0", "1", "2", "3", "4"), 
                    values = c("green3", "red1", "red2", "red3", "red4"),
                    labels = c("No CTE", "CTE Stage I", "CTE Stage II", "CTE Stage III", "CTE Stage IV")) + 
  guides(fill=guide_legend(title=NULL)) + 
  theme(legend.position = c(0.9, 0.8), #Adjust legend position
        panel.background = element_rect(fill="white"),
        legend.background = element_rect(colour = 'black', fill = 'white', linetype='solid')) + # Background white
  scale_y_continuous(expand = c(0,0)) + scale_x_continuous(expand = c(0,0), breaks = seq(0,33,by=1)) # Remove extra space around plot


